*****************************************************************************
***                                                                       ***
***  VD6    -  Emissao de Pedidos  e Nota Fiscal e Duplicata              ***
***  Autor      : Luis Lin                                                ***
***  Last Update : 05/11/97  - 11/08/2003                                 ***
***                                                                       ***
*****************************************************************************
PROCEDURE VD016(nPedido,I)
#include "Inkey.ch"
#include "set.ch"
#define ROMAN_S CHR(27)+CHR(107)+CHR(48)
#define COMP_S CHR(15)
#define COMP_N CHR(18)
#define EXP_S  CHR(14)
#define EXP_N  CHR(20)
#define ITALIC_ON CHR(27)+CHR(52)
#define ITALIC_OFF CHR(27)+CHR(53)
#define DHIGHT_S CHR(27)+CHR(119)+CHR(49)   // ESC w 1
#define DHIGHT_N CHR(27)+CHR(119)+CHR(48)   // ESC w 0
#define DHIGH_S CHR(27)+CHR(87)+CHR(49)   // ESC W 1
#define DHIGH_N CHR(27)+CHR(87)+CHR(48)   // ESC W 0
#define EMPHA_S CHR(27)+CHR(69)
#define EMPHA_N CHR(27)+CHR(70)
#define DSTRIK_S CHR(27)+CHR(71)
#define DSTRIK_N CHR(27)+CHR(72)
#define ENLARGE_DH_S CHR(27)+CHR(126)+CHR(49)+CHR(49)
#define ENLARGE_QH_S CHR(27)+CHR(126)+CHR(49)+CHR(50)
#define ENLARGE_DW_S CHR(27)+CHR(126)+CHR(49)+CHR(51)
#define ENLARGE_QW_S CHR(27)+CHR(126)+CHR(49)+CHR(52)
#define ENLARGE_DHDW_S CHR(27)+CHR(126)+CHR(49)+CHR(53)
#define ENLARGE_QHQW_S CHR(27)+CHR(126)+CHR(49)+CHR(54)
#define ENLARGE_N CHR(27)+CHR(126)+CHR(49)+CHR(48)
#define REVERSO_S CHR(27)+CHR(126)+CHR(50)+CHR(49)
#define REVERSO_N CHR(27)+CHR(126)+CHR(50)+CHR(48)
#define PRO_SPA_S CHR(27)+CHR(112)+CHR(49)      // ESC P 1
#define PRO_SPA_N CHR(27)+CHR(112)+CHR(48)  // ESC p 0
#define RESET_M CHR(27)+CHR(64)
local nArea := select()
*  use clientes index ncodc new alias CFO
*  use pedidoma index npedido new alias PEDM
*  set relation  to PEDM->cl_ncodcli into CFO
*  set order to tag npedidoma

*   use transpor new alias TR
   use transpor index ncodt new alias TR
   use vendedor new alias vendedor
   use prod     new alias PR
   use pedidosi new alias PEDI
   if i = 1
          impNF(nPedido)
      imppedido(nPedido)
      close TR
      close vendedor
      close PR
      close PEDI
      select(nArea)
      return .t.
   elseif i = 2
      imppedido(nPedido)
      close TR
      close vendedor
      close PR
      close PEDI
      select(nArea)
      return .t.
   elseif i = 3
      impNF(nPedido)
      close TR
      close vendedor
      close PR
      close PEDI
      select(nArea)
      return .t.
   else
      impDup(nPedido)
      close TR
      close vendedor
      close PR
      close PEDI
      select(nArea)
      return .t.
   endif
   select(nArea)
return .t.


static function imppedido(nPedido)
Local  ac_nlinha, ac_nitens:= 0, pag:=1,via:=2, nCol, lin:= 0, col:= 0, total:=0
Local codcli := PEDM->cl_ncodcli
Local tpag   := tpagina(PEDM->pm_ntitem,15)
Local codtra := TR->tr_ncodtra
Local codtran:= PEDM->pm_ncodtra
Local vend   := PEDM->pm_nvender
Local MesHora:= str(day(date()))+" "+Brmonth(month(date()))+str(year(date())) + space(3) + time()
  if ! ISPRINTER()
         SET CURSOR ON
         SET DEVICE TO SCREEN
         SET CONSOLE ON
         SET PRINT OFF
         SET PRINTER TO
         disp_mens({"Impressora desligada"},.t.)
         if  lastkey() == K_ESC
             return
         endif
    ENDif
    sele PEDM
    set order to tag ncodcli
    sele CFO
    set order to tag ncodcli
    go top
    seek str(codcli)
    sele TR
    set order to tag ncodtra
    go top
    seek str(codtran)

    SET DEVICE TO PRINTER
    SET CONSOLE OFF
    SET PRINT ON
    SET PRINT TO LPT1
*   SET PRINTER TO pedido.txt
    SET CURSOR OFF
for n = 1 to via
    if pag = 2 .and. n = 2
       pag := 1
       lin := 0
       ac_nitens := 0
       total := 0
    elseif pag = 1 .and. n = 2
       lin := 36
       ac_nitens := 0
       total := 0
    else
       lin := 0
       pag := 1
       ac_nitens := 0
       total := 0
    endif
    SELE PEDI && TENS DE PEDIDOS
    set order to tag npeditem
    SET SOFTSEEK ON
    GO TOP
    SEEK STR(nPedido,5,0)
    SET SOFTSEEK OFF
       ac_nitens  := ac_nitens + 1
    do while PEDI->PI_NPEDIDO == nPedido
       @ lin+0, 1 say COMP_N + DHIGHT_S + EMPHA_S + "BenyStar" + DHIGHT_N + EMPHA_N + " / Data Pedido: " + ITALIC_ON + dtoc(PEDM->pm_ddatped) + space(26) + ITALIC_OFF+DHIGHT_S+ "Pedido N. " + EMPHA_S +"* -"+ TRANSFORM(nPedido,"@E 99,999")+DHIGHT_N + EMPHA_N
       @ lin+2, 1 say "Cliente.: " + PrintCod(ITALIC_ON) + strzero(CFO->cl_ncodcli) + space(3) + CFO->cl_cnomcfo
       @ lin+3, 1 say PrintCod(ITALIC_OFF) + "Endereco: "+PrintCod(ITALIC_ON)+ alltrim(CFO->cl_cendcfo) + space(5) + alltrim(CFO->cl_cbaicfo)
       @ lin+4,11 say alltrim(CFO->cl_ccidcfo) + space(10) + alltrim(CFO->cl_cestcfo)
       @ lin+4,60 say "Cond. Pagto.: " + PrintCod(ITALIC_ON) + PEDM->pm_ccondpg
       if Ptrans(@codtran) = "Nosso carro"
          @ lin+5, 1 say PrintCod(ITALIC_ON) + "Vendedor: "+ Pvende(@vend)
       else
          @ lin+5, 1 say PrintCod(ITALIC_ON) + "Vendedor: "+ Pvende(@vend) + " - " +Ptrans(@codtran)
       endif
       @ lin+5,59 say PrintCod(ITALIC_OFF) + "Vencimento: " + PrintCod(ITALIC_ON) + dtoc((PEDM->pm_ddatent)+val(substr(PEDM->pm_ccondpg,1,2)))+PrintCod(ITALIC_OFF)

       @ lin+06, 00 say REPLICATE('-', 80)
       @ lin+07, 01 say PrintCod(COMP_S) + "item     codigo    quantidade   un      d e s c r i c a o        " +;
                    SPACE(30) + "preco unitario          subtotal-item"
       @ lin+08, 00 say PrintCod(COMP_N) + REPLICATE('-',137) + PrintCod(COMP_S)

       ac_nlinha  := lin+09
       nCol := 1

       DO WHILE  PEDI->PI_NPEDIDO == nPedido .and. ac_nlinha < lin+24
          if eof()
             exit
          endif
          @ ac_nlinha, nCol say ;
                   TRANSFORM(ac_nitens, "@E 99") + SPACE(7) +;
                   TRANSFORM(PEDI->PI_CCODPRO,"@!") + SPACE(2) +;
                   TRANSFORM(PEDI->PI_NQTY,"@E 99,999") + SPACE(6) +;
                   codpro(PEDI->pi_ccodpro,3)
          @ ac_nlinha, nCol+95 say;
                   transform(PEDI->PI_NPREVEN, "@ZE 99,999,999.99") + SPACE(10)+;
                   TRANSFORM(PEDI->PI_NQTY * PEDI->PI_NPREVEN, "@ZE 99,999,999.99")
          total = total + (PEDI->PI_NQTY * PEDI->PI_NPREVEN)
          SKIP 1
          ac_nitens++
          ac_nlinha++
       ENDDO

       @ ac_nlinha,100 say PrintCod(COMP_N) + replicate("-",20)
       if pag = tpag
*          @ ac_nlinha + 1 ,44 say + "Sub-Total......: " + space(4) + transform(PEDM->pm_ntotped, "@E 99,999,999.99")
          @ ac_nlinha + 1 ,44 say + "Sub-Total......: " + space(4) + transform(total, "@E 99,999,999.99")
          @ ac_nlinha + 3 ,44 say + "Totais.........: " + space(4) + transform(total, "@E 99,999,999.99")
*          @ ac_nlinha + 3 ,44 say + "Totais.........: " + space(4) + transform(PEDM->pm_ntotped, "@E 99,999,999.99")
       else
          @ ac_nlinha +2 ,44 say "Continua na Pag.: "+ str(pag+1,2,0)
       endif
       if PEDM->pm_ddatent <> PEDM->pm_ddatped
          @ lin+29, ncol say "Data de Entrega: "+ DTOC(PEDM->pm_ddatent)
       endif
       if alltrim(PEDM->pm_clocent) # "O mesmo"
          @ lin+30,ncol say "Local de Entrega: "+ PEDM->pm_clocent
       endif

       @ lin+31,ncol say + "Totais de Volumes....: " + space(2) + transform(PEDM->pm_ntvol,  "@E 999")
       @ lin+32, 00 say REPLICATE('-', 80)
       @ lin+33, 00 say str(pag,2,0) +"/" + str(tpag,2,0)
       @ lin+33, 80-len(MesHora) say MesHora   //str(day(date()))+" "+Brmonth(month(date()))+str(year(date())) + space(3) + time()
       if tpag == 2
          lin := 36
          pag++
       endif
    enddo
next
SELECT PEDM && PEDIDOSM

EJECT
SET CURSOR ON
SET DEVICE TO SCREEN
SET CONSOLE ON
SET PRINT OFF
SET PRINTER TO
RETURN .t.



static function impNF(nPedido)
Local  ac_nlinha, ac_nitens:= 0, pag:=1,via:=1, nCol, lin:= 0, col:= 0,;
       ntotal := 0,totnor := 0,totsub := 0,ntotipi := 0,t_ipinor:=0,t_ipisub:=0
Local codcli := PEDM->cl_ncodcli
Local tpag   := tpagina(PEDM->pm_ntitem,15)
Local codtra := TR->tr_ncodtra
Local vend   := PEDM->pm_cvender
Local estado := CFO->cl_cestcfo
Local natope := PEDM->pm_cnatope
Local codtran:= PEDM->pm_ncodtra
Local codp   := PEDI->pi_ccodpro
  if ! ISPRINTER()
         SET CURSOR ON
         SET DEVICE TO SCREEN
         SET CONSOLE ON
         SET PRINT OFF
         SET PRINTER TO
         disp_mens({"Impressora desligada"},.t.)
         if  lastkey() == K_ESC
             return
         endif
    ENDif
    sele PEDM
    set order to tag ncodcli
    sele CFO
    set order to tag ncodcli
    go top
    seek str(codcli)
    estado := CFO->cl_cestcfo
    sele TR
    set order to tag ncodtra
    go top
    seek str(codtra)

    SET DEVICE TO PRINTER
    SET CONSOLE OFF
    SET PRINT ON
    set printer to LPT2
*   SET PRINTER TO nf.TXT
    SET CURSOR OFF

    SELE PEDI && TENS DE PEDIDOS
    set order to tag npeditem
    SET SOFTSEEK ON
    GO TOP
    SEEK STR(nPedido,5,0)
    SET SOFTSEEK OFF
       ac_nitens  := ac_nitens + 1
    do while PEDI->PI_NPEDIDO == nPedido
       @ lin+1, 1 say COMP_N +space(1)
       if   PEDM->pm_ctipo == "S"
            @ lin+2, 82 say  "X"
       else                        // tipo Entrada
            @ lin+2, 92 say  "X"
       endif
*      @ lin+3, 41 say PrintCod(ITALIC_OFF) + "CEP 01021-200 - Centro - Sao Paulo - SP"
       @ lin+4, 31 say "Fone:(011) 3311 0604-3312 0425 Fax 011 3311 9804"
       @ lin+6, 29 say cnatope(@natope)
       if PEDM->pm_cnatope == "600"
           @ lin+6, 60 say "599.1"
       else
           @ lin+6, 60 say natope
       endif
*      @ lin+6, 82 say "113.212.410.110"
       @ lin+9, 29 say CFO->cl_cnomcfo + space(1) + str(CFO->cl_ncodcli,5,0)
       @ lin+9, 82 say transform(CFO->cl_ncgccli, "@R 99.999.999/9999-99") +space(6)+ dtoc(date())
       @ lin+11,29 say CFO->cl_cendcfo + space(1) + CFO->cl_cbaicfo + space(1) + TRANSFORM(CFO->cl_ncepcfo,"@R 99999-999")
       @ lin+13,29 say CFO->cl_ccidcfo + space(30) + CFO->cl_cestcfo + space(2) + transform(CFO->cl_cinscli,"@R 999.999.999.999")+ PrintCod(COMP_N)
       @ lin+14,00 say Printcod(COMP_S)

       ac_nlinha  := lin+17
       nCol := 1

       DO WHILE  PEDI->PI_NPEDIDO == nPedido .and. ac_nlinha < lin+46            // maximo com 29 item
          if eof()
             exit
          endif
          @ ac_nlinha, nCol say ;
                   TRANSFORM(PEDI->PI_CCODPRO,"@!") + SPACE(1) +;
                   codpro(PEDI->pi_ccodpro,1)


          if alltrim(codpro(PEDI->pi_ccodpro,11)) == "A6"  //  importacao proprio
              if val(codpro(PEDI->pi_ccodpro,8)) = 0  // DI.E novo
                  if  val(codpro(PEDI->pi_ccodpro,5)) <> 0
                      if  val(codpro(PEDI->pi_ccodpro,7)) <> 0
                          @ ac_nlinha, nCol+55 say  codpro(PEDI->pi_ccodpro,4)
                      else
                          @ ac_nlinha, nCol+55 say  codpro(PEDI->pi_ccodpro,6)
                      endif
                 endif
              else
                  @ ac_nlinha, nCol+60 say  codpro(PEDI->pi_ccodpro,9)
              endif
          endif
          if  ws_ctipo == "E" .or. ws_cnatope == "7102"
              @ ac_nlinha, nCol+96 say;
                   transform(padr(PR->pr_nclasfi,10), "@BR 9999 99 9999") + SPACE(7)+ PR->pr_csittri +space(4)+ codpro(PEDI->pi_ccodpro,2)+;
                   space(3)+ TRANSFORM(PEDI->PI_NQTY,"@E 99,999")+ space(8)+transform(0     , "@ZE 99,999.99") + space(7) + TRANSFORM(PEDI->PI_NPREVEN, "@ZE 99,999,999.99")
                   if PEDI->PI_NPREVEN  # 0
                      @ ac_nlinha, nCol+169 say str(icms(@estado),3,0)+space(2)+transform(PR->pr_nipi, "@E 999") +space(5)+ TRANSFORM(PEDI->pi_npreven * PR->PR_NIPI/100, "@ZE 99,999.99")
                   endif
          else
              if ws_cnatope == "5905" .and.  codcli == 465
                  @ ac_nlinha, nCol+96 say;
                      transform(padr(PR->pr_nclasfi,10), "@BR 9999 99 9999") + SPACE(7)+ PR->pr_csittri +space(4)+ codpro(PEDI->pi_ccodpro,2)+;
                     space(3)+ TRANSFORM(PEDI->PI_NQTY,"@E 99,999")+ space(8)+transform(round(PEDI->pi_npreuni * .7,2), "@ZE 99,999.99") + space(7) + TRANSFORM(PEDI->PI_NQTY * round(PEDI->PI_NPREUNI*.7,2), "@ZE 99,999,999.99")
                     ntotal =ntotal + (PEDI->PI_NQTY * round(PEDI->PI_NPREUNI*.7,2))
*                  space(3)+ TRANSFORM(PEDI->PI_NQTY,"@E 99,999")+ space(8)+transform(0     , "@ZE 99,999.99") + space(7) + TRANSFORM(PEDI->PI_NPREVEN, "@ZE 99,999,999.99")
*                  if PEDI->PI_NPREVEN  # 0
*                     @ ac_nlinha, nCol+169 say str(icms(@estado),3,0)+space(2)+transform(PR->pr_nipi, "@E 999") +space(5)+ TRANSFORM(PEDI->pi_npreven * PR->PR_NIPI/100, "@ZE 99,999.99")
*                  endif

*                    space(3)+ TRANSFORM(PEDI->PI_NQTY,"@E 99,999")+ space(8)+transform(PEDI->pi_npreuni, "@ZE 99,999.99") + space(7) + TRANSFORM(PEDI->PI_NQTY * PEDI->PI_NPREUNI, "@ZE 99,999,999.99")
*                    ntotal =ntotal + (PEDI->PI_NQTY * PEDI->PI_NPREUNI)
**                     str(icms(@estado),3,0)+space(2)+transform(PR->pr_nipi, "@E 999") +space(5)+ TRANSFORM(PEDI->pi_nqty * PEDI->pi_npreuni * PR->PR_NIPI/100, "@ZE 99,999.99")
              elseif ws_cnatope == "5905"
                  @ ac_nlinha, nCol+96 say;
                      transform(padr(PR->pr_nclasfi,10), "@BR 9999 99 9999") + SPACE(7)+ PR->pr_csittri +space(4)+ codpro(PEDI->pi_ccodpro,2)+;
                    space(3)+ TRANSFORM(PEDI->PI_NQTY,"@E 99,999")+ space(8)+transform(0     , "@ZE 99,999.99") + space(7) + TRANSFORM(PEDI->PI_NPREVEN, "@ZE 99,999,999.99")
                    if PEDI->PI_NPREVEN  # 0
                       @ ac_nlinha, nCol+169 say str(icms(@estado),3,0)+space(2)+transform(PR->pr_nipi, "@E 999") +space(5)+ TRANSFORM(PEDI->pi_npreven * PR->PR_NIPI/100, "@ZE 99,999.99")
                    endif

*                    space(3)+ TRANSFORM(PEDI->PI_NQTY,"@E 99,999")+ space(8)+transform(PEDI->pi_npreuni, "@ZE 99,999.99") + space(7) + TRANSFORM(PEDI->PI_NQTY * PEDI->PI_NPREUNI, "@ZE 99,999,999.99")
*                    ntotal =ntotal + (PEDI->PI_NQTY * PEDI->PI_NPREUNI)
**                     str(icms(@estado),3,0)+space(2)+transform(PR->pr_nipi, "@E 999") +space(5)+ TRANSFORM(PEDI->pi_nqty * PEDI->pi_npreuni * PR->PR_NIPI/100, "@ZE 99,999.99")
              else
                  @ ac_nlinha, nCol+96 say;
                      transform(padr(PR->pr_nclasfi,10),"@bR 9999 99 9999") + SPACE(7)+ PR->pr_csittri +space(4)+ codpro(PEDI->pi_ccodpro,2)+;
                      space(3)+ TRANSFORM(PEDI->PI_NQTY,"@E 99,999")+ space(8)+transform(PEDI->pi_npreuni, "@ZE 99,999.99") + space(7) + TRANSFORM(PEDI->PI_NQTY * PEDI->PI_NPREUNI, "@ZE 99,999,999.99") +;
                      str(icms(@estado),3,0)+space(2)+transform(PR->pr_nipi, "@E 999") +space(5)+ TRANSFORM(PEDI->pi_nqty * PEDI->pi_npreuni * PR->PR_NIPI/100, "@ZE 99,999.99")
                      if alltrim(PEDI->pi_ccodpro) == "HH031-C5B"
                         t_ipisub = t_ipisub + (PEDI->pi_nqty * PEDI->pi_npreuni * PR->PR_NIPI/100)
                         totsub = totsub + (PEDI->PI_NQTY *PEDI->PI_NPREUNI)
                      else
                         t_ipinor = t_ipinor + (PEDI->pi_nqty * PEDI->pi_npreuni * PR->PR_NIPI/100)
                         totnor = totnor + (PEDI->PI_NQTY *PEDI->PI_NPREUNI)
                      endif
                      ntotipi = t_ipisub + t_ipinor
                      ntotal = totnor + totsub
              endif
          endif
          SKIP 1
          ac_nitens++
          ac_nlinha++
       ENDDO
       if ws_cnatope == "5905"
          @ lin+46, nCol+11 say "Nao incidencia de ICMS conf. artigo 7o. inciso III no decreto 33.118/91"
          @ lin+47, nCol say PrintCod(COMP_N)
          @ lin+48,ncol+59 say PrintCod(COMP_N) + transform(ntotal,"@ZE 999,999.99")
          @ lin+50,ncol+59 say transform(ntotal,"@ZE 999,999.99")
*               @ lin+48,ncol say PrintCod(COMP_N) + transform((PEDM->pm_ntotal + PEDM->pm_ntipi),  "@E 999,999.99")+ space(5)+transform((PEDM->pm_ntotal + PEDM->pm_ntipi)*icms(@estado)/100,"@ZE 999,999.99")+ space(34) + transform(PEDM->pm_ntotal,"@ZE 999,999.99")
*               @ lin+50,ncol+43 say  PrintCod(COMP_N) + transform(PEDM->pm_ntipi,  "@E 999,999.99")+ space(6)+transform((PEDM->pm_ntotal + PEDM->pm_ntipi),"@ZE 999,999.99")
          @ lin+53,ncol+2 say Ptrans(codtran)
       else
          if pag == 1
             if ws_ctipo == "E"
                @ lin+46, nCol+11 say "Valor do I.I. Incluso no Valor Total"
                @ lin+48,ncol say PrintCod(COMP_N) + transform((PEDM->pm_ntotal + PEDM->pm_ntipi),  "@E 999,999.99")+ space(5)+transform((PEDM->pm_ntotal + PEDM->pm_ntipi)*icms(@estado)/100,"@ZE 999,999.99")+ space(34) + transform(PEDM->pm_ntotal,"@ZE 999,999.99")
                @ lin+50,ncol+43 say  PrintCod(COMP_N) + transform(PEDM->pm_ntipi,  "@E 999,999.99")+ space(6)+transform((PEDM->pm_ntotal + PEDM->pm_ntipi),"@ZE 999,999.99")
                @ lin+53,ncol+2 say Ptrans(codtran)
             else
*                @ lin+48,ncol say PrintCod(COMP_N) + transform((PEDM->pm_ntotal + PEDM->pm_ntipi),  "@E 999,999.99")+ space(5)+transform((PEDM->pm_ntotal + PEDM->pm_ntipi)*icms(@estado)/100,"@ZE 999,999.99")+ space(34) + transform(PEDM->pm_ntotal,"@ZE 999,999.99")
                @ lin+48,ncol say PrintCod(COMP_N) + transform((totnor + t_ipinor),  "@E 999,999.99")+ space(5)+transform((totnor + t_ipinor)*icms(@estado)/100,"@ZE 999,999.99")+space(5)+ transform((totsub + t_ipisub),  "@E 999,999.99")+ space(5)+transform((totsub + t_ipisub)*icms(@estado)/100,"@ZE 999,999.99")+ space(5) + transform(ntotal,"@ZE 999,999.99")
                @ lin+50,ncol+43 say  PrintCod(COMP_N) + transform(ntotipi,  "@E 999,999.99")+ space(6)+transform((ntotal + ntotipi),"@ZE 999,999.99")
                @ lin+53,ncol+2 say Ptrans(codtran)
             endif
          else
                @ lin+46, nCol+10 say "Obs:Complemento da Nota Fiscal No."+str(ws_nnf,5,0)
          endif
       endif
       if (ws_ctipo == "E" .or. ws_cnatope == "7102" ) = .f.
           @ lin+53,ncol+41 say  "2"
           @ lin+57,ncol say transform(PEDM->pm_ntvol,"@ZE 99,999") + space(3) + "Caixa"+space(32) + transform(PEDM->pm_npesob,"@EZ 99,999.99 KG")+space(1)+transform(PEDM->pm_npesol,"@EZ 99,999.99 KG")
       endif
       lin := 0
       pag++
    enddo
SELECT PEDM && PEDIDOSM

EJECT
SET CURSOR ON
SET DEVICE TO SCREEN
SET CONSOLE ON
SET PRINT OFF
SET PRINTER TO
RETURN .t.



static function impDup(nPedido)
Local  ac_nlinha, ac_nitens:= 0, pag:=1,via:=1, nCol, lin:= 0, col:= 0,;
       ntotal := 0,totnor := 0,totsub := 0,ntotipi := 0,t_ipinor:=0,t_ipisub:=0
Local codcli := PEDM->cl_ncodcli
Local tpag   := tpagina(PEDM->pm_ntitem,15)
Local codtra := TR->tr_ncodtra
Local vend   := PEDM->pm_cvender
Local estado := CFO->cl_cestcfo
Local natope := PEDM->pm_cnatope
Local codtran:= PEDM->pm_ncodtra
Local codp   := PEDI->pi_ccodpro
  if ! ISPRINTER()
         SET CURSOR ON
         SET DEVICE TO SCREEN
         SET CONSOLE ON
         SET PRINT OFF
         SET PRINTER TO
         disp_mens({"Impressora desligada"},.t.)
         if  lastkey() == K_ESC
             return
         endif
    ENDif
    sele PEDM
    set order to tag ncodcli
    sele CFO
    set order to tag ncodcli
    go top
    seek str(codcli)
    estado := CFO->cl_cestcfo
    sele TR
    set order to tag ncodtra
    go top
    seek str(codtra)

    SET DEVICE TO PRINTER
    SET CONSOLE OFF
    SET PRINT ON
    set printer to LPT2
*   SET PRINTER TO dup.TXT
    SET CURSOR OFF

    SELE PEDI && TENS DE PEDIDOS
    set order to tag npeditem
    SET SOFTSEEK ON
    GO TOP
    SEEK STR(nPedido,5,0)
    SET SOFTSEEK OFF
       ac_nitens  := ac_nitens + 1
    do while PEDI->PI_NPEDIDO == nPedido
      @ lin+1, 1 say  COMP_S + space(1)
      @ lin+3, 73 say  cnatope(@natope)
      @ lin+4, 05 say "Fone 11 33110604 Fax 11 33119804                                    Rodoviario"
      @ lin+5, 73 say  dtoc(PEDM->pm_ddatped)

      @ lin+8, 24 say  PEDM->pm_nnf
      @ lin+8, 50 say  transform((PEDM->pm_ntotped + PEDM->pm_ntipi),"@ZE 999,999.99")
      @ lin+8, 78 say  PEDM->pm_nnf
      @ lin+8, 95 say  "C/APRES."

      @ lin+12,37 say  CFO->cl_cnomcfo
      @ lin+12,120 say  str(CFO->cl_ncodcli,5,0)
      @ lin+13,32 say  CFO->cl_cendcfo +space(20) +TRANSFORM(CFO->cl_ncepcfo,"@R 99999-999")
      @ lin+14,32 say  CFO->cl_ccidcfo +space(43) +CFO->cl_cestcfo + space(25)+TRANSFORM(nPedido,"@E 99,999")
      @ lin+17,40 say  transform(CFO->cl_ncgccli, "@R 99.999.999/9999-99") +space(35) +transform(CFO->cl_cinscli,"@R 999.999.999.999")

        aExt = fextenso(PEDM->pm_ntipi + PEDM->pm_ntotped,50,'*',1,1,'{','}')
        aCont = 1
        do while aCont <= len(aExt)
           @ lin+18+aCont,40 say aExt[aCont]
           ACont++
        enddo

      exit
      

    enddo

SELECT PEDM && PEDIDOSM

EJECT
SET CURSOR ON
SET DEVICE TO SCREEN
SET CONSOLE ON
SET PRINT OFF
SET PRINTER TO
RETURN .t.








STATIC FUNCTION PrintCod(cod)
    Local nLin,nCol, lPrinter
    lPrinter := SET(_SET_PRINTER, .T.)
    nLin := prow()
    nCol := pcol()
    //
    ?? cod
    //
    SETPRC(nLin,nCOL)
    SET(_SET_PRINTER, lPrinter)
return ""

FUNCTION codpro(cod,n)
Local nWorkArea
nWorkArea := select()
sele PR
     set order to tag ccodpro
     seek cod
     if ! found()
          set cursor on
          set device to screen
          set console on
          Disp_Mens({"Produto nao Cadastrado....!"},.t.)
          set cursor off
          set device to printer
          set console off
          cStr := "Produto nao Cadastrado"
          select(nWorkArea)
          return cStr
     ELSE
        cStr1 := alltrim(PR->pr_cunid)             //PROCURAR O CARGO NA TABELA
        cStr2 := alltrim(PR->pr_cnompro)            //PROCURAR O CARGO NA TABELA
        cStr3 := str(PR->pr_nnumgi,13,0)            //PROCURAR O CARGO NA TABELA
        cStr4 := str(PR->pr_nnumdi,06,0)            //PROCURAR O CARGO NA TABELA
        cStr5 := "GI: "+TRANSFORM(PR->pr_nnumgi, "@ZE 9999-99/999999-9")+SPACE(1)+"DI: "+alltrim(strZERO(PR->pr_nnumdi,6,0))+space(1)+dtoc(PR->pr_ddatedi)            //PROCURAR O CARGO NA TABELA
        cStr6 := "GI: "+TRANSFORM(PR->pr_nnumgi, "@ZE 9999-99/999999-9")       //PROCURAR O CARGO NA TABELA
        cStr7 := str(PR->pr_ndie,10,0)
        cStr8 := "DI: "+TRANSFORM(PR->pr_ndie, "@E 99/9999999-9")+space(1)+dtoc(PR->pr_ddatedi)        //PROCURAR O CARGO NA TABELA
        cStr9 := alltrim(PR->pr_cnompr1)            //PROCURAR O CARGO NA TABELA
        cStr10:= alltrim(PR->pr_csittri)            //PROCURAR O CARGO NA TABELA
        if n = 1
           select(nWorkArea)
           RETURN cStr2
        elseif n = 3
           select(nWorkArea)
           return cStr1 + space(2) + cStr2
        elseif n = 4
           select(nWorkArea)
           return cStr5
        elseif n = 5
           select(nWorkArea)
           return cStr3
        elseif n = 6
           select(nWorkArea)
           return cStr6
        elseif n = 7
           select(nWorkArea)
           return cStr4
        elseif n = 8
           select(nWorkArea)
           return cStr7
        elseif n = 9
           select(nWorkArea)
           return cStr8
        elseif n = 10
           select(nWorkArea)
           return cStr1 + SPACE(2) + cStr9
        elseif n = 11
           select(nWorkArea)
           return cStr10
        else
           select(nWorkArea)
           return cStr1
        endif
ENDIF


FUNCTION Pvende(cod)
Local nWorkArea
Local cStr:= ""
nWorkArea := select()
     if ! empty(cod)
         sele vendedor
         go top
         set order to tag ncodven
         seek cod
         if ! found()
              set cursor on
              set device to screen
              set console on
              Disp_Mens({"Vendedor/a nao Cadastrado....!"},.t.)
              set cursor off
              set device to printer
              set console off
              cStr := "Vendedor/a nao Cadastrado"
              select(nWorkArea)
              return cStr
         ELSE
              cStr := alltrim(vendedor->ve_cnomred)
              select(nWorkArea)
              RETURN cStr     //FUNCAO QUE VOCE PEGARA PEDACO DE UM STRING
        ENDIF
     else
              cStr := "Vendedor/a nao Cadastrado"
              RETURN cStr     //FUNCAO QUE VOCE PEGARA PEDACO DE UM STRING
     endif
return cStr




FUNCTION Ptrans(codi)
Local nWorkArea
Local cStr:= ""
nWorkArea := select()
     if ! empty(codi)
         sele TR
         set order to tag ncodtra
         go top
         seek str(codi,4,0)
         if ! found()
              set cursor on
              set device to screen
              set console on
              Disp_Mens({"Transportadora nao Cadastrado....!"},.t.)
              set cursor off
              set device to printer
              set console off
              cStr := "Transportadora nao Cadastrado"
              select(nWorkArea)
              return cStr
         ELSE
              cStr := alltrim(TR->tr_cnomred) + space(3) + alltrim(TR->tr_xteltra)
              select(nWorkArea)
              RETURN cStr     //FUNCAO QUE VOCE PEGARA PEDACO DE UM STRING
        ENDIF
     else
              cStr := "Transportadora nao Cadastrado"
              RETURN cStr     //FUNCAO QUE VOCE PEGARA PEDACO DE UM STRING
     endif
return cStr


/*
static function tpagina(exp, npl)
local K := 0
   if exp < npl
      return npl
   else
      do while .t.
         k++
         if npl * k > exp
            return npl * k
         endif
      enddo
   endif
return .t.
*/


static function tpagina(exp, npl)
local k := 0, resto := 0
   k = int(exp / npl)
   resto = exp % npl
   if k < 1
      k = 1
      return k
   endif
   if resto # 0
      k = k +1
   endif
return k


static FUNCTION cvend(vender)
LOCAL TABvend := {"Ang",;   //
                  "Lui",;   //
                  "Kim",;   //
                  "Fen",;   //
                  "Fer",;   //
                  "Uni",;   //
                  "Eqi",;   //
                  "Jul"}    //
LOCAL TAAvend := {"Angelica",;
                  "Luis",;
                  "Kimiko",;
                  "Fernando",;
                  "Ferreira Rep",;
                  "Uni Sul-Ary",;
                  "Equipe",;
                  "Julia"}
IF (vender $ "AngLuiKimFenFerUniEqiJul") = .f.
      RETURN "Vendedor nao cadastrado"
ELSE
      elem:= ASCAN(TABvend,vender)            //PROCURAR O CARGO NA TABELA
      if elem = 0
         return "elemento nao encontrado"
      else
         RETURN alltrim(SUBSTR(TAAvend [elem],1,12))     //FUNCAO QUE VOCE PEGARA PEDACO DE UM STRING
      endif
ENDIF

static FUNCTION cnatope(ope)
LOCAL TABope := {"5102",;
                 "512 ",;
                 "612 ",;
                 "6102",;
                 "3102",;
                 "7102",;
                 "5910",;
                 "5911",;
                 "5905",;
                 "5917",;
                 "5918"}
LOCAL TAAope := {"Venda",;
                 "Venda",;
                 "Venda",;
                 "Venda",;
                 "Importacao",;
                 "Exportacao",;
                 "Remessa em brindes/doacao",;
                 "Amostra gratis",;
                 "Remessa p/deposito",;
                 "Remessa em consignacao",;
                 "Devolucao em consignacao"}
IF (ope $ "512 612 510261023102710259105911590559175918") = .f.
      RETURN "Nat.Operacao Nao Cadastrado"
ELSE
      elem:= ASCAN(TABope,ope)            //PROCURAR O CARGO NA TABELA
      if elem = 0
         return "elemento nao encontrado"
      else
         RETURN SUBSTR(TAAope [elem],1,25)     //FUNCAO QUE VOCE PEGARA PEDACO DE UM STRING
      endif
ENDIF

FUNCTION icms(esta)
Local icm := 0
nWorkArea := select()
use estadoss new alias EST
    locate for siglas == esta
    if found()
       icm := EST->icms
    else
       icm := 18
    endif
close EST
select(nWorkArea)
return icm


function Brmonth(mes)
local Cmes := ""
   do case
      case mes == 1
           Cmes := "Janeiro"
      case mes == 2
           Cmes := "Fevereiro"
      case mes == 3
           Cmes := "Marco"
      case mes == 4
           Cmes := "Abril"
      case mes == 5
           Cmes := "Maio"
      case mes == 6
           Cmes := "Junho"
      case mes == 7
           Cmes := "Julho"
      case mes == 8
           Cmes := "Agosto"
      case mes == 9
           Cmes := "Setembro"
      case mes == 10
           Cmes := "Outubro"
      case mes == 11
           Cmes := "Novembro"
      case mes == 12
           Cmes := "Dezembro"
   endcase
return Cmes


*
* Valores por extenso
* Desenvolvida por Antonio Carlos
*
*
* Exemplos de funcionamento da funcao
*
* Basta compilar
*

/*
Clear

nValor := 0

@ 00,00 say "Valor :" Get nValor Picture "@e 999,999,999.99"
Read

@ 02,00 say "Valor: "+ transform(nValor,"@e999,999,999.99")

*aExt = fextenso(nValor,30)
?
aExt = fextenso(nValor,40,'*',2,1,'{','}')
aCont = 1
do while aCont <= len(aExt)
   ? aExt[aCont]
   ACont++
enddo
?
? aExt
return
*/

*
* Depois de rodar altere os valores e a configuracao voce vai gostar
*

*
* Funcao para conversao de valores por extenso
* Desenvolvida por Antonio Carlos
*
* aNumero    Numero a ser transformado
* aColunas   Define a quantidade de colunas das linhas
* aPreenche  Define o caracter que vai preencher as sobras em branco da linha
* aTipo      (1) preenche sem justificar (2) preenche justificando
* aUpper     (1) minusculo (2) maiusculo
* aAbre      Define o caracter de abertura da macro exp : '(' - '(Cem reais)'
* aFecha     Idem ao item de cima mas para o fechamento
*
* Retorna matriz array com quantidade de linhas necessarias para texto
*

Function fextenso(aNumero, aColunas, aPreenche, aTipo, aUpper, aAbre, aFecha)
local aMil, aMilhao, aMilhoes, aMoeda, aMoeda1, aCentavo, aCentavos, aCents
local alinha[0]
local aPos, aContador, aFinal, aDezena, aContLin, aExtenso

if aAbre = nil
   aAbre = ''
endif

if aFecha = nil
   aFecha = ''
endif

if aUpper = nil
   aUpper = 1
endif

if aTipo = nil
   aTipo = 1
endif

if aPreenche = nil
   aPreenche = '*'
endif

if aColunas = nil
   aColunas = 60
endif

if aNumero = nil
   return({space(aColunas)})
endif

if aNumero = 0
   return({space(aColunas)})
endif

n00=' '
n01='UM '
n02='DOIS '
n03='TRES '
n04='QUATRO '
n05='CINCO '
n06='SEIS '
n07='SETE '
n08='OITO '
n09='NOVE '
n10='DEZ '
n11='ONZE '
n12='DOZE '
n13='TREZE '
n14='QUATORZE '
n15='QUINZE '
n16='DEZESSEIS '
n17='DEZESSETE '
n18='DEZOITO '
n19='DEZENOVE '
n20='VINTE '
n30='TRINTA '
n40='QUARENTA '
n50='CINQUENTA '
n60='SESSENTA '
n70='SETENTA '
n80='OITENTA '
n90='NOVENTA '
n000=' '
n100='CENTO '
n200='DUZENTOS '
n300='TREZENTOS '
n400='QUATROCENTOS '
n500='QUINHENTOS '
n600='SEISCENTOS '
n700='SETECENTOS '
n800='OITOCENTOS '
n900='NOVECENTOS '

aMil='MIL '
aMilhao='MILHAO '
aMilhoes='MILHOES '
aMoeda='REAIS '
aMoeda1='REAL '
aCentavo='CENTAVO'
aCentavos='CENTAVOS'

aNumero1 = str(aNumero,13,2)
aCents    = str((aNumero-int (aNumero))*100,2)
aNumero  = int(aNumero)
aContador = 1

aPart1=substr(aNumero1,2,3)
aPart2=substr(aNumero1,5,3)
aPart3=substr(aNumero1,8,3)
aPart4=aCents

aTextoExt1=''
aTextoExt2=''
aTextoExt3=''
aTextoExt4=''

if val (aPart1) >0
    aStatus1= iif (val (aPart1) >1,'2','1')
else
    aStatus1=' '
endif

do while aContador <=4
   aItem=str (aContador,1)
   aGrupo= 'aPart'+str (aContador,1)
   aExtenso=iif (&aGrupo='000','',ltrim(&aGrupo))

   do case

      case len (aExtenso)=3

         if aExtenso='100'
            aTextoExt&aItem=aTextoExt&aItem+'CEM '
            aContador=aContador+1
            loop
         endif

         if right (aExtenso,2)='00'
            aTab='n'+substr(aExtenso,1,1)+'00'
            aTextoExt&aItem=aTextoExt&aItem+&aTab
            aContador=aContador+1
            loop
         endif

         aTab='n'+left(aExtenso,1)+'00'
         aTextoExt&aItem=&aTab +'E '
         aDezena=val(right(aExtenso,2))

         if aDezena <20
            aTab='n'+right(aExtenso,2)
            aTextoExt&aItem=aTextoExt&aItem+&aTab
            aContador=aContador+1
            loop
         else
            aTab='n'+substr(aExtenso,2,1)+'0'
            aTextoExt&aItem=aTextoExt&aItem+&aTab
            aTab='n0'+right (aExtenso,1)
            unidade=val(right (aExtenso,1))

            if unidade > 0
               aTextoExt&aItem=aTextoExt&aItem +iif (val(aExtenso)>10,'E ','')
            endif

            aTextoExt&aItem=aTextoExt&aItem+iif(aTab='n00',' ',&aTab)
         endif

      case len(aExtenso)=2

         aDezena=val(right(aExtenso,2))

         if aDezena < 20
            aTab='n' + right(aExtenso,2)
            aTextoExt&aItem=aTextoExt&aItem+&aTab
            aContador=aContador+1
            loop
         else
            aTab='n'+ substr(aExtenso,1,1)+'0'
            aTextoExt&aItem=aTextoExt&aItem + &aTab
            aTab='n0' + right (aExtenso,1)
            unidade1=val (right(aExtenso,1))

            if unidade1 > 0
               aTextoExt&aItem=aTextoExt&aItem+'E '
            endif

            aTextoExt&aItem=aTextoExt&aItem+iif (aTab='n00',' ',&aTab)
         endif

      case len(aExtenso)=1

         aTab='n0' + right(aExtenso,1)
         aTextoExt&aItem=aTextoExt&aItem + iif(aTab='n00',' ',&aTab)

      otherwise

         aTextoExt&aItem=''

   endcase

   aContador=aContador+1
enddo

if val (aPart1+aPart2+aPart3)=0 .and. val(aPart4)#0
   aFinal=aTextoExt4+(iif (val (aPart4)=1,aCentavo,aCentavos))
endif

if val(aPart1+aPart2+aPart3)#0
   aFinal= iif (len(aTextoExt1)=0,'',aTextoExt1 +iif (aStatus1='1',aMilhao, aMilhoes))+    iif(len(aTextoExt2)=0,'',   aTextoExt2+aMil)  + aTextoExt3 +iif(val(aPart2+aPart3)=0 ,'de ','')
   aFinal= aFinal+ iif(val (aPart1+aPart2+aPart3)=0 ,'',iif(val (aPart1+aPart2+aPart3)=1, aMoeda1,aMoeda))
   aFinal= aFinal+ iif(val (aPart4)=0,'',iif(val(aPart1+aPart2+aPart3)=0,'','E ') + aTextoExt4 + (iif(val(aPart4)=1,aCentavo,aCentavos)))
endif

if aUpper = 1
   aFinal = substr(aFinal,1,1)+lower(substr(aFinal,2))
endif

aFinal = aAbre+alltrim(aFinal)+aFecha

do while len(aFinal) > aColunas
   aPos = aColunas+1
   do while substr(aFinal,aPos,1) <> " "
      aPos--
   enddo
   aadd(alinha,alltrim(substr(aFinal,1,aPos)))
   aFinal = alltrim(substr(aFinal,aPos))
enddo

aadd(alinha,alltrim(aFinal))

if aTipo > 1
   aContLin = 1
   do while aContLin < len(alinha)
      alinha[aContLin] := fjustifica(alinha[aContLin],aColunas)
      aContLin++
   enddo
endif

aContLin = 1
do while aContLin <= len(alinha)
   alinha[aContLin] := alinha[aContLin]+replicate(aPreenche,aColunas-len(alinha[aContLin]))
   aContLin++
enddo

return(aLinha)



*
* Funcao para justificar textos
* Desenvolvida por Antonio Carlos
*
* aTexto   Linha de texto a ser justificada
* aColunas Numero de colunas desejavel
*
* Retorna o texto justificado de acordo com o numero de colunas

Function fjustifica(aTexto, aColunas)
local aPos

aTexto := alltrim(aTexto)

if len(aTexto) >= aColunas
   return(aTexto)
endif

do while .t.
   aPos = len(aTexto)
   do while aPos > 1
      do while substr(aTexto,aPos,1) <> " "
         aPos--
      enddo
      do while substr(aTexto,aPos,1) = " "
         aPos--
      enddo
      aTexto := substr(aTexto,1,aPos)+' '+substr(aTexto,aPos+1)
      if len(aTexto) = aColunas
         exit
      endif
   enddo
   if len(aTexto) = aColunas
      exit
   endif
enddo
return(aTexto)

